perm filename LNEND.F4[P11,LCS] blob sn#579534 filedate 1981-04-15 generic text, type T, neo UTF8
C***** LNEND, BARS, SCAN2, SCAN3, SCAN4

	SUBROUTINE LNEND
      COMMON/ALF/JNP(72),ML/MKX/LSL
     1 /SCX/JALPHA(30),JX,RA,JZ,IRHY,RB,KA,KB,IZ 
     1 /JCHAR/IXX,ISEMI,JBLA,IG
      EQUIVALENCE (LST,JALPHA(8)),(LCM,JALPHA(10))
	K=1
C IF BAD INPUT PUT ISEMI INTO ALF(4) [JNP1] AT END
C  LST  *   SCX+7
C  LCM	;
C  LSL  /
	K3=1
	K5=72
2901	IF(LSL.NE.JNP(K3))GO TO 2903
	K=K3
	GO TO 2902
2903 	IF(LCM.NE.JNP(K3))GO TO 2902
	JNP(K3)=LST
	RETURN
2902 	K3=K3+1     
	IF(K3.LE.K5)GO TO 2901
	JNP(K)=LCM
C  GET LOC. OF LAST /
	END

	SUBROUTINE BARS
      COMMON /ALF/INP(72),ML /SC/J,LSC,MK
     1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
     1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
C ***** BARS =4000  ****** ; THE 1 IS FOR BAR ONE STAFF ONLY.
        QZ=4001.
2002    JN=INP(ML)
        IF(JN.EQ.LDD)GO TO 3002
        IF(JN.NE.LMM)GO TO 23
        VX(1)=VX(1)+1.
        ML=ML+1
        GO TO 2002
C  GO BACK AND LOOK FOR MORE M'S  ML=ML+1
3002    ML=ML+1
C     FOUND 'MDN' -- FOR DOUBLE BARS
      JN=0
        QZ=-QZ
C   DBL BARS ARE NEG.
23      VX(1)=QZ
        K=NALF(INP(ML))
      IF(K.LE.0)RETURN
      IF(K.GT.9)RETURN
C   NO MORE THAN 8 STAVES UP ALLOWED.
        K=K-1
C  BECAUSE ORIG. NUM WAS 4001, NOT 4000
        IF(JN.EQ.0)K=-K
C   NEG. IF DBL BAR
        VX(1)=VX(1)+K
C  'M2'= A BAR LINE UP 2 STAVES. ETC.
	END

	SUBROUTINE SCAN2(QZ)
C FOR METER(Tm n), STEM DIR.(SU,SD), STAFF UP-DN
      COMMON /ALF/INP(72),ML /SC/J,LSC,MK
     1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
     1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
4     IF(K.NE.20)GO TO 21
	QZ=-1
C   TRY AGAIN IF NOT A 'T'
      IF(INP(ML).GT.0)RETURN
C   T12,8/ ETC. MAKES A METR, OR TIM SIG. POS NUMS AREN'T LETRS!
C ***** CLEFS = 3000 *****  CODE 3.
        QZ=3000.
        IF(INP(ML).EQ.LEE)QZ=QZ+3.
C    TENOR CLEF =3003, TREBLE=3000
	RETURN
C   NOT AN 'S'(STEM OR STAFF), UNKNOWN ITEM, SKIP IT.
21        KI=INP(ML)
C SU  UP=5010
        QQ=0
        IF(KI.EQ.LUU)QQ=10.
        IF(KI.EQ.LDD)QQ=20.
C  DOWN = 5020
        IF(KI.EQ.'+')QQ=2.
C   S+=5002
        IF(KI.EQ.'-')QQ=1.
C   S-=5001
C   S0=5000
C   THESE ARE FOR S+, S-, S0; PUT NOTE ON OTHER STF.
        VX(1)=5000.+QQ
	QZ=0
	END

	SUBROUTINE SCAN3(NSWCH)
C  FOR NOTE NAMES.
      COMMON /ALF/INP(72),ML /SC/J,LSC,MK
     1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
     1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
6       K=K-2
C   -2 BECAUSE MUSICAL ALPHABET STARTS WITH C
        IF(K.LE.0)K=K+7
        NNUM=K
        KQ=1000
        K=1
        IF(NNUM.GT.3)K=K+1
C   FOUND A NOTE
        IF(N.EQ.JXX)GO TO 5410
C  FOR GX3/ ETC.
 
        IF(N.NE.INP(ML-1))GO TO 66
C   NO DOUBLE-LETTER ACCID. (FLAT)
        IF(N.NE.INP(ML+1))GO TO 88
C   NO TRIPLE-LETTER ACCID. (SHARP)
        ML=ML+1
        IF(N.NE.INP(ML+1))GO TO 8
C   NO TRIPLE-LETTER ACCID. (NATURAL)
        ML=ML+1
        KQ=1300
C  TYPE AA FOR AF, AAA = AS, AAAA = AN
        GO TO 610
 
66      K=NALF(N)
        IF(N.GT.0)GO TO 7
C   JUMP IF NOT A LETTER
        KQ=1300
C   ;  ***** NOTES  ***** =1000  2ND DIG=ACCI.
        IF(K.EQ.22)GO TO 610
C *** CAN USE 'V' FOR NATURAL(EASIER TO HIT!!)
        IF(K.EQ.14)GO TO 610
C   JUMP IF NATURAL
        IF(K.EQ.19)GO TO 8
C  -- S -- 
88      KQ=1100
C  IT'S A FLAT
        GO TO 610
8       KQ=1200
C  SHARP =1200
610   ML=ML+1
        NK=INP(ML)
      K=NALF(NK)
        IF(NK.GE.0)GO TO 7
C  IF CHAR. ISN'T A LETTER, GO TO S7
C  (LETTERS ARE NEG., NUMBS ARE POS.)
        IF(K.NE.19)GO TO 777
C  IF(K.EQ.19) THEN IT'S SS
C  FOR DBL FLAT, DBL SHARP
        KQ=1500
C   DBL FLAT
        GO TO 610
777     IF(K.NE.6)GO TO 7
C  IS IT 'FF'?
        KQ=1400
C  FF=1400, SS=1500
        GO TO 610
C  GO BACK FOR ANOTHER CHAR.
7     IF(K.EQ.11)GO TO 5410
C IS IT 'K'?
      IF(K.LT.0)GO TO 5410
C IF SEMICOLON OR BLANK
      IF(K.NE.24)GO TO 24
C  IS IT 'X'?
        GO TO 5410
24    JSCA=K
C  SAVE OCT. NUM
      ML=ML+1
      GO TO 2410
5410  IF(NSWCH.EQ.0)GO TO 2410
      JJ=NOLD-NNUM
        IF(JJ.GE.4)JSCA=JSCA+1
        IF(JJ.LE.-4)JSCA=JSCA-1
C  WILL JUMP TO NEAREST NOTE  (DIATONIC-'75)
2410    JJ=1
      VX2=0
        QQ=JSCA*7+NNUM+KQ
        VX(1)=QQ*DBST
C  DOUBLE STOPS ARE NEG. NnUMBERS
      NOLD=NNUM
C  ABOVE FINDS SCALE NOTES; IF NSWCH=0 OCT. NUM WILL STICK UNTIL RESET
        END       

	SUBROUTINE SCAN4
C FOR KEY SIGS.
      COMMON /ALF/INP(72),ML /SC/J,LSC,MK
     1 ,ISKP,XMINUS,N,REXP,LK,NNUM,JJ,JN,DBST,NFLG,JXX,JSEMI,QQ
     1 ,VX(50),IAMP,K,RRN,M,MODE,IBLA
	COMMON/A2Z/LAA,LBB,LCC,LDD,LEE,LFF,LGG,LHH,LII,LJJ,LKK,LEL,LMM
	1 ,LNN,LOH,LPP,LQQ,LRR,LSS,LTT,LUU,LVV,LWW,LXX,LYY,LZZ
      QQ=17000.
CC**** NUM FOR KEY SIGS ***
18    N=INP(ML)
      ML=ML+1
      IF(N.EQ.IBLA)GO TO 18
        IF(N.NE.LNN)GO TO 200
C  IS IT AN N?  K3FN/  OR  K2SN/ MAKES NATURALS
C  IF NEXT CHAR='N' A 'NATURALS' KEY SIG.
        QZ=100.
        IF(QQ.LE.0)QZ=-QZ
        QQ=QQ+QZ
        GO TO 18
200     IF(N.EQ.LSS)GO TO 18
      IF(N.EQ.'+')GO TO 18
      IF(N.EQ.JSEMI)GO TO 20
      IF(N.EQ.'-')N=LFF
      IF(N.NE.LFF)GO TO 19
        QQ=-QQ
C  NEG. FOR FLATS
	GO TO 18
19    A=NALF(N)
        GO TO 18
C  GO BACK AND LOOK AGAIN
20      IF(QQ.LT.0)A=-A
        VX(1)=QQ+A
C   KSIG
	END